(ns clojure-web.html
  (:import (clojure.lang PersistentList Keyword Symbol)))

;(import '(clojure.lang PersistentList Keyword Symbol))

;;; Utilities

(defn- escape-string [string]
  "Escape html special characters in STRING."
  (let [rules [["<", "&lt;"],
	       ["&", "&quot;"]]]
    (reduce (fn [string [regex replacement]]
	      (.replaceAll string regex replacement))
	    string rules)))

(defn print-safe [& args]
  "Like print, but escapes html special characters."
  (apply print (map (comp escape-string print-str) args)))

(defn print-tag [& args]
  (print (str "<" (apply print-str args) ">")))

(defn format-attr [[name value]]
  (format "%s=\"%s\"" (name name) value))

;;; HTML Expression

(defn- html-exp?
  "Return true if LIST is an html expression."
  [list]
  (or (keyword? (first list))
      (and (list? (first list))
	   (keyword? (first (first list))))))

(defn- html-tag
  "Return the tag of html expression EXP."
  [exp]
  (if (list? (first exp))
    (first (first exp))
    (first exp)))

(defn- html-attr
  "Return the attributes of html expression EXP."
  [exp]
  (if (list? (first exp))
    (rest (first exp))))

(defn- html-body
  "Return the body of html expression EXP."
  [exp]
  (rest exp))

;;; Code Generation

(defmulti
  #^{:doc "Generate the code for emitting html, dispatch by type."}
  html-gen class)

(defmethod html-gen Symbol [exp]
  `(print-safe ~exp))

(defmethod html-gen Keyword [exp]
  `(print-tag (name ~exp) "/"))

(defmethod html-gen String [exp]
  `(print-safe ~exp))

(defmethod html-gen Number [exp]
  `(print-safe ~exp))
	    
(defmethod html-gen PersistentList [list]
  (if (html-exp? list)
    `(do (apply print-tag (name ~(html-tag list))
		(map format-attr (partition 2 (list ~@(html-attr list)))))
	 ~@(map html-gen (html-body list))
	 (print-tag (str "/" (name ~(html-tag list)))))
    list))

;;; Macro

(defmacro html
  "Convert html-expressions in body to print statements."
  [& body] 
  `(do ~@(map html-gen body)))
